home *** CD-ROM | disk | FTP | other *** search
- { Graph Units 1..4 }
-
- uses Graph,Txt;
-
- var GrData:array[0..119,1..2] of integer;
- Pal:array[0..767] of byte;
-
- { ─────────────── InitGr ─────────────── }
- procedure InitGr(No,N:integer);
- var I:integer;
- A,R:real;
- begin
- A:=0;
- case No of
- 1:for I:=0 to 119 do begin
- R:=100*(0.5+0.5*Sin(N*A));
- GrData[I,1]:=Trunc(R*Cos(A));
- GrData[I,2]:=Trunc(R*Sin(A));
- A:=A+Pi/60;
- end;
- 2:for I:=0 to 119 do begin
- R:=100*(0.82+0.18*Sin(3*N*A))*(0.5+0.5*Sin(N*A));
- GrData[I,1]:=Trunc(R*Cos(A));
- GrData[I,2]:=Trunc(R*Sin(A));
- A:=A+Pi/60;
- end;
- 3:for I:=0 to 119 do begin
- R:=100*(0.33*Sin(0.5*N*A)+Sin(N*A));
- GrData[I,1]:=Trunc(R*Cos(2*A));
- GrData[I,2]:=Trunc(R*Sin(2*A));
- A:=A+Pi/30;
- end;
- 4:for I:=0 to 119 do begin
- GrData[I,1]:=Trunc(100*Sin(N*A)*Cos(A));
- GrData[I,2]:=Trunc(100*Sin(N*A+A)*Sin(A));
- A:=A+Pi/60;
- end;
- end;
- end;
- { ─────────────── DrawGr ─────────────── }
- procedure DrawGr(Cx,Cy,Rx,Ry,Color:integer);
- var I:integer;
- Data:array[0..119,1..2] of integer;
- begin
- for I:=0 to 119 do begin
- Data[I,1]:=GrData[I,1]*Rx div 100+Cx;
- Data[I,2]:=GrData[I,2]*Ry div 100+Cy;
- end;
- SetColor(Color);
- for I:=0 to 118 do Line(Data[I,1],Data[I,2],Data[I+1,1],Data[I+1,2]);
- Line(Data[119,1],Data[119,2],Data[0,1],Data[0,2]);
- end;
-
- var A,B,I:integer;
- begin
- A:=InstallUserDriver('SVGA256',nil); B:=2;
- InitGraph(A,B,'');
- GetPalette(0,256,Pal);
- SetFillStyle(1,104); Bar(0,0,640,480);
- InitGr(1,4);
- for I:=0 to 95 do DrawGr(160,120,108-I,108-I,64+I div 3);
- InitGr(2,2);
- for I:=0 to 119 do DrawGr(480,120,128-I,128-I,64+I div 3);
- InitGr(3,5);
- for I:=0 to 39 do DrawGr(165,355,80-2*I,80-2*I,83-I div 2);
- InitGr(4,7);
- for I:=0 to 19 do DrawGr(475,355,100-4*I,100-4*I,64+I);
- CirclePalette(64,40,80,30,Pal);
- Readln;
- CloseGraph;
- RestoreCrtMode;
- end.
-